CellIsSpring Function

public function CellIsSpring(row, col, flowDir) result(spring)

find the cells that are springs, defined as those cells that have not any other cells upstream

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: row
integer, intent(in) :: col
type(grid_integer), intent(in) :: flowDir

Return Value logical


Source Code

FUNCTION CellIsSpring &
!
(row, col, flowDir) &
!
RESULT (spring)

IMPLICIT NONE

! Arguments with intent(in):
INTEGER, INTENT(in) :: row, col
TYPE (grid_integer), INTENT(in) :: flowDir

! Local variables:
LOGICAL :: spring

!------------end of declaration------------------------------------------------
spring = .TRUE.

IF (flowDir % mat(row,col) == flowDir % nodata) THEN
  spring = .FALSE.
  RETURN
END IF

IF(.NOT. IsOutOfGrid(row,col+1,flowDir) ) THEN
    IF(flowDir%mat(row,col+1) == W ) THEN
       spring = .FALSE.
       RETURN
    ENDIF
ENDIF

IF(.NOT. IsOutOfGrid(row+1,col+1,flowDir) ) THEN
    IF(flowDir%mat(row+1,col+1) == NW  ) THEN
       spring = .FALSE.
       RETURN
    ENDIF
ENDIF

IF(.NOT. IsOutOfGrid(row+1,col,flowDir) ) THEN
    IF(flowDir%mat(row+1,col) == N  ) THEN
      spring = .FALSE.
       RETURN
    ENDIF
ENDIF

IF(.NOT. IsOutOfGrid(row+1,col-1,flowDir) ) THEN
    IF(flowDir%mat(row+1,col-1) == NE  ) THEN
       spring = .FALSE.
       RETURN
    ENDIF
ENDIF

IF(.NOT. IsOutOfGrid(row,col-1,flowDir) ) THEN
    IF(flowDir%mat(row,col-1) == E  ) THEN
       spring = .FALSE.
       RETURN
    ENDIF
ENDIF

IF(.NOT. IsOutOfGrid(row-1,col-1,flowDir) ) THEN
    IF(flowDir%mat(row-1,col-1) == SE  ) THEN
       spring = .FALSE.
       RETURN
    ENDIF
ENDIF

IF(.NOT. IsOutOfGrid(row-1,col,flowDir) ) THEN
    IF(flowDir%mat(row-1,col) == S  ) THEN
       spring = .FALSE.
       RETURN
    ENDIF
ENDIF

IF(.NOT. IsOutOfGrid(row-1,col+1,flowDir) ) THEN
    IF(flowDir%mat(row-1,col+1) == SW  ) THEN
       spring = .FALSE.
       RETURN
    ENDIF
ENDIF


END FUNCTION CellIsSpring